home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / ztrexc.f < prev    next >
Text File  |  1996-07-19  |  5KB  |  164 lines
  1.       SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
  2. *
  3. *  -- LAPACK routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     March 31, 1993
  7. *
  8. *     .. Scalar Arguments ..
  9.       CHARACTER          COMPQ
  10.       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
  11. *     ..
  12. *     .. Array Arguments ..
  13.       COMPLEX*16         Q( LDQ, * ), T( LDT, * )
  14. *     ..
  15. *
  16. *  Purpose
  17. *  =======
  18. *
  19. *  ZTREXC reorders the Schur factorization of a complex matrix
  20. *  A = Q*T*Q**H, so that the diagonal element of T with row index IFST
  21. *  is moved to row ILST.
  22. *
  23. *  The Schur form T is reordered by a unitary similarity transformation
  24. *  Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
  25. *  postmultplying it with Z.
  26. *
  27. *  Arguments
  28. *  =========
  29. *
  30. *  COMPQ   (input) CHARACTER*1
  31. *          = 'V':  update the matrix Q of Schur vectors;
  32. *          = 'N':  do not update Q.
  33. *
  34. *  N       (input) INTEGER
  35. *          The order of the matrix T. N >= 0.
  36. *
  37. *  T       (input/output) COMPLEX*16 array, dimension (LDT,N)
  38. *          On entry, the upper triangular matrix T.
  39. *          On exit, the reordered upper triangular matrix.
  40. *
  41. *  LDT     (input) INTEGER
  42. *          The leading dimension of the array T. LDT >= max(1,N).
  43. *
  44. *  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N)
  45. *          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
  46. *          On exit, if COMPQ = 'V', Q has been postmultiplied by the
  47. *          unitary transformation matrix Z which reorders T.
  48. *          If COMPQ = 'N', Q is not referenced.
  49. *
  50. *  LDQ     (input) INTEGER
  51. *          The leading dimension of the array Q.  LDQ >= max(1,N).
  52. *
  53. *  IFST    (input) INTEGER
  54. *  ILST    (input) INTEGER
  55. *          Specify the reordering of the diagonal elements of T:
  56. *          The element with row index IFST is moved to row ILST by a
  57. *          sequence of transpositions between adjacent elements.
  58. *          1 <= IFST <= N; 1 <= ILST <= N.
  59. *
  60. *  INFO    (output) INTEGER
  61. *          = 0:  successful exit
  62. *          < 0:  if INFO = -i, the i-th argument had an illegal value
  63. *
  64. *  =====================================================================
  65. *
  66. *     .. Local Scalars ..
  67.       LOGICAL            WANTQ
  68.       INTEGER            K, M1, M2, M3
  69.       DOUBLE PRECISION   CS
  70.       COMPLEX*16         SN, T11, T22, TEMP
  71. *     ..
  72. *     .. External Functions ..
  73.       LOGICAL            LSAME
  74.       EXTERNAL           LSAME
  75. *     ..
  76. *     .. External Subroutines ..
  77.       EXTERNAL           XERBLA, ZLARTG, ZROT
  78. *     ..
  79. *     .. Intrinsic Functions ..
  80.       INTRINSIC          DCONJG, MAX
  81. *     ..
  82. *     .. Executable Statements ..
  83. *
  84. *     Decode and test the input parameters.
  85. *
  86.       INFO = 0
  87.       WANTQ = LSAME( COMPQ, 'V' )
  88.       IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
  89.          INFO = -1
  90.       ELSE IF( N.LT.0 ) THEN
  91.          INFO = -2
  92.       ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
  93.          INFO = -4
  94.       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
  95.          INFO = -6
  96.       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
  97.          INFO = -7
  98.       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
  99.          INFO = -8
  100.       END IF
  101.       IF( INFO.NE.0 ) THEN
  102.          CALL XERBLA( 'ZTREXC', -INFO )
  103.          RETURN
  104.       END IF
  105. *
  106. *     Quick return if possible
  107. *
  108.       IF( N.EQ.1 .OR. IFST.EQ.ILST )
  109.      $   RETURN
  110. *
  111.       IF( IFST.LT.ILST ) THEN
  112. *
  113. *        Move the IFST-th diagonal element forward down the diagonal.
  114. *
  115.          M1 = 0
  116.          M2 = -1
  117.          M3 = 1
  118.       ELSE
  119. *
  120. *        Move the IFST-th diagonal element backward up the diagonal.
  121. *
  122.          M1 = -1
  123.          M2 = 0
  124.          M3 = -1
  125.       END IF
  126. *
  127.       DO 10 K = IFST + M1, ILST + M2, M3
  128. *
  129. *        Interchange the k-th and (k+1)-th diagonal elements.
  130. *
  131.          T11 = T( K, K )
  132.          T22 = T( K+1, K+1 )
  133. *
  134. *        Determine the transformation to perform the interchange.
  135. *
  136.          CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
  137. *
  138. *        Apply transformation to the matrix T.
  139. *
  140.          IF( K+2.LE.N )
  141.      $      CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
  142.      $                 SN )
  143.          CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS,
  144.      $              DCONJG( SN ) )
  145. *
  146.          T( K, K ) = T22
  147.          T( K+1, K+1 ) = T11
  148. *
  149.          IF( WANTQ ) THEN
  150. *
  151. *           Accumulate transformation in the matrix Q.
  152. *
  153.             CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
  154.      $                 DCONJG( SN ) )
  155.          END IF
  156. *
  157.    10 CONTINUE
  158. *
  159.       RETURN
  160. *
  161. *     End of ZTREXC
  162. *
  163.       END
  164.